

;; consider the following for easy debug

;; 1. Turn optimization off, use highest settings for safety and debug
;; (declaim (optimize (safety 3)) (optimize (debug 3)) (optimize (speed 0)))

;; 2. Use step call, e.g. if you have translate-to-c function that uses one argument,
;;    you may use:
;; (step (translate-to-c (get-flow-mappings-1)))


;;
;; simple unit-testing framework
;;

(defvar *test-name* nil)

(defvar *test-report-stream* *standard-output*)

(defmacro deftest (name parameters &body body)
  "Define a test function. Within a test function we can call
   other test functions or use 'check' to run individual test
   cases."
  `(defun ,name ,parameters
    (let ((*test-name* (append *test-name* (list ',name))))
      ,@body)))

(defmacro report-result (expr)
  "Report the results of a single test case"
  (let* ((func-name (car expr))
	 (params (cdr expr))
	 (result (gensym "result-"))
	 (arg-names (loop for i in params for j from 0 collect
			  (gensym (format nil "arg-~a-" j)))))
    `(let* (,@(loop for arg in arg-names for j from 0 collect
		    `(,arg ,(nth j params)))
	    (,result (,func-name ,@arg-names)))
       (format *test-report-stream* "~:[FAIL~;pass~] ~a: ~a" ,result *test-name* ',expr)
       (if (and (null ,result) ',arg-names)
	   (format *test-report-stream* ", evaluated args: ~a" (list ,@arg-names)))
       (write-char #\Newline *test-report-stream*)
       ,result)))

(defmacro assert-t (expr)
  `(report-result ,expr))

(defmacro assert-equals (left-expr right-expr)
  `(report-result (equal ,left-expr ,right-expr)))

(defmacro assert-nil (expr)
  `(report-result (null ,expr)))

;;
;; stringify utils
;;

(defun symbol-to-c-name (sym)
  (declare (symbol sym))
  (let* ((source-name (princ-to-string sym))
	 (result-name (make-string (length source-name))))
    (loop for pos from 0 to (1- (length source-name)) do
	 (let ((ch (aref source-name pos)))
	   (setf
	    (aref result-name pos)
	    (cond
	      ((or
		(and (char>= ch #\a) (char<= ch #\z))
		(and (char>= ch #\0) (char<= ch #\9) (> pos 0))
		(char= ch #\_))
	       ;; leave it as-is in case of matching valid characters range
	       ch)

	      ;; all the uppercase symbols will be converted to their lowercase counterparts
	      ((and (char>= ch #\A) (char<= ch #\Z))
	       (code-char (+ (- (char-code ch)
				(char-code #\A))
			     (char-code #\a))))
	      
	      ;; replace all the other characters with an underscore
	      (t #\_)))))
    result-name))

(defun stringify-type-id (type-id)
  (symbol-to-c-name type-id))

(defun stringify-arg (arg-id)
  (symbol-to-c-name arg-id))


;;
;; type declaration
;;

;; type root
(defclass type-root ()
  ((semantics :accessor semantics :initform nil)))

(defclass type-alias (type-root)
  ((name :reader name :initarg :name)))

(defclass type-pointer (type-root)
  ((target :reader target :initarg :target)))

(defclass type-const (type-root)
  ((target :reader target :initarg :target)))

(defclass type-array (type-root)
  ((element-type :reader element-type :initarg :element-type)
   (size :reader size :initarg :size)))


(defclass type-spec ()
  ((c-str :reader c-str :initarg :c-str)

   ;; default name for the corresponding argument
   (default-name :reader default-name :initarg :default-name :initform nil)

   ;; defines whether this type spec is an array or not
   (is-array :reader is-array :initform nil)))

(defparameter *type-registry* nil)

(defun type-registry ()
  (unless *type-registry*
    (progn
      (setf *type-registry* (make-hash-table))

      ;; add predefined types
      (flet ((add (type-id type-c-str)
	       (setf (gethash type-id *type-registry*)
		     (make-instance 'type-spec
				    :c-str type-c-str
				    :default-name (stringify-type-id type-id)))))
	(add 'int "int")
	(add 'time "time_t")
	(add 'cstr "const char *"))))
  *type-registry*)


(defparameter *arg-type-aliases* nil)

(defun arg-type-aliases ()
  (unless *arg-type-aliases*
    (progn
      (setf *arg-type-aliases* (make-hash-table))
      (flet ((add (arg-id type-id)
	       (setf (gethash arg-id *arg-type-aliases*)
		     (let ((type-spec (gethash type-id (type-registry))))
		       (unless type-spec (error "#arg-type-aliases > there is no such type"))
		       type-spec))))
	(add 'id 'int)
	(add 'name 'cstr)
	(add 'created 'time))))
  
  *arg-type-aliases*)


(defparameter *dlc-struct-sample*
  '(struct sample-name
    id
    name
    (int age)
    created))

(defun print-typed-pair (expr)
  (let (type-spec arg-id)
    (typecase expr
      (symbol (progn
		(setf type-spec (gethash expr (arg-type-aliases)))		
		(setf arg-id expr)))

      (cons (progn
	      (unless (= (length expr) 2) (error "unknown form"))
	      (setf type-spec (gethash (car expr) (type-registry)))
	      (setf arg-id (cadr expr))
	      (unless (symbolp arg-id) (error "argument identifier is not a symbol"))))
      
      (nil (error "field form is not known")))

    (unless type-spec (error "type inference failed for the given arg: no associated type"))
    (format t "~a ~a" (c-str type-spec) (stringify-arg arg-id))))

(defun dissect-struct (struct-def)
  (format t "struct ~a {~%" (stringify-type-id (car struct-def)))
  (dolist (field (cdr struct-def))
    (format t "    ")
    (print-typed-pair field)
    (format t ";~%"))
  (format t "};~%"))


;; (dissect-struct '(bosch id name))
;; (dissect-struct '(bosch-t id name (cstr notes) (int full-age)))

(defparameter *url-mapping-sample*
  '(
    (url-mapping
     ("/index" (mvc :controller 'main-page :method 'index)))

    (controller main-page)

    (func index ()
     (render "index.markup.lisp"))

    (rem)))

(defparameter *domain-sample*
  '((rem "domain types definition sample")

    (alias
     (int "*-id")
     (cstr "*-name"))
    
    (struct profile
     id
     display-name)

    (constraints "profile > display-name"
     (size-min 3)
     (size-max 64)
     (regexp "^[a-zA-Z\d]+$"))

    ;;
    ;; dao
    ;;

    (type generic-dao dao)

    ;; calls:
    ;; gets profile from dao by ID
    (get 'profile (dao) :id 0)

    (let (new-profile)
      (set new-profile (profile))
      
      (set (id new-profile) 12)
      (set (display-name new-profile) "alex")
      (persist new-profile (dao)))
    
    (rem)))


(defparameter *data-def-sample*
  '())



;;
;; dissecting TODO:
;; TO have two different layouts to the source code:
;; 1-st layout is to represent cross-platform code
;; 2-nd layout - for translating to C code

(defun dissect ()
  (format t "dissecting web app~%"))

;; UT
(deftest test-struct-def ()
  (assert-equals (dissect-struct '(bosch id name))
		 "struct bosch {
    int id;
    const char * name;
};"))